home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / SystemCode / prefs.tcl < prev    next >
Text File  |  1996-08-18  |  7KB  |  318 lines
  1.  
  2.  
  3. #===============================================================================
  4.  
  5.  
  6. proc addArrDef {arr def val} {
  7.     addDef [list $arr $def] $val arr
  8. }
  9.  
  10. proc removeArrDef {arr def} {
  11.     removeDef [list $arr $def] arr
  12. }
  13.  
  14. proc addDef {def val {prefix {}}} {
  15.     global ${prefix}prefDefs
  16.     
  17.     readDefs $prefix
  18.     set ${prefix}prefDefs($def) $val
  19.     writeDefs $prefix
  20.     catch {unset ${prefix}prefDefs}
  21. }
  22.  
  23. proc removeDef {def {prefix {}}} {
  24.     global ${prefix}prefDefs
  25.     
  26.     readDefs $prefix
  27.     catch {unset ${prefix}prefDefs($def)}
  28.     writeDefs $prefix
  29.     catch {unset ${prefix}prefDefs}
  30. }
  31.  
  32. proc readDefs {{prefix {}}} {
  33.     global HOME PREFS globalPrefix
  34.  
  35.     if {![file exists "$PREFS:${prefix}defs.tcl"]} return
  36.     
  37.     set globalPrefix $prefix
  38.     uplevel #0 {source "$PREFS:${globalPrefix}defs.tcl"}
  39. }
  40.  
  41.  
  42. proc writeDefs {{prefix {}}} {
  43.     global HOME PREFS ${prefix}prefDefs 
  44.     
  45.     if {![info exists ${prefix}prefDefs]} {
  46.         catch {removeFile "$PREFS:${prefix}defs.tcl"}
  47.         return
  48.     }
  49.     
  50.     if {![file exists "$PREFS"]} {
  51.         mkdir "$PREFS"
  52.     }
  53.     set fd [open "$PREFS:${prefix}defs.tcl" "w"]
  54.     foreach nm [array names ${prefix}prefDefs] {
  55.         puts $fd [list set ${prefix}prefDefs($nm) [set ${prefix}prefDefs($nm)]]
  56.     }
  57.     close $fd
  58. }
  59.  
  60.  
  61. proc readUserDefs {} {
  62.     global prefDefs arrprefDefs PREFS
  63.     
  64.     if {[file exists "$PREFS:defs.tcl"]} {
  65.         source "$PREFS:defs.tcl"
  66.         
  67.         foreach nm [array names prefDefs] {
  68.             global $nm
  69.             set $nm $prefDefs($nm)
  70.         }
  71.         catch {unset prefDefs}
  72.     }
  73.     
  74.     if {[file exists "$PREFS:arrdefs.tcl"]} {
  75.         source "$PREFS:arrdefs.tcl"
  76.         
  77.         foreach nm [array names arrprefDefs] {
  78.             set arr [lindex $nm 0]
  79.             set field [lindex $nm 1]
  80.             set val $arrprefDefs($nm)
  81.             global $arr
  82.             set ${arr}($field) $val
  83.         }
  84.         catch {unset arrprefDefs}
  85.     }
  86.  
  87.     # Use "prefs.tcl" to define or change any tcl information. */
  88.     if {![file exists "$PREFS:prefs.tcl"]} {
  89.         
  90.         if {![file exists "$PREFS"]} {
  91.             mkdir "$PREFS"
  92.         }
  93.         set fd [open "$PREFS:prefs.tcl" "w"]
  94.         close $fd
  95.     }
  96.     uplevel #0 {
  97.         if {[catch {source "$PREFS:prefs.tcl"}]} {
  98.             alertnote "An error occurred while loading ¥"prefs.tcl¥"" 
  99.         }
  100.     }
  101. }
  102.  
  103.     
  104. proc viewSavedSetting {} {
  105.     global prefDefs arrprefDefs
  106.  
  107.     saveModifiedVars
  108.     
  109.     readDefs
  110.     readDefs arr
  111.     
  112.     set res [listpick -p "The following settings have been saved:" [getSavedSettings]]
  113.  
  114.     if {[regexp {([^(]+)¥(([^)]+)¥)} $res dummy arr field]} {
  115.         set arg [list $arr $field]
  116.         set val $arrprefDefs($arg)
  117.         if {[string length $val] > 80} {
  118.             global tileLeft tileTop tileWidth
  119.             new -g $tileLeft $tileTop $tileWidth 100 -n "¥$${arr}($field)"
  120.             insertText "'$res's value is:¥r¥r$val¥r"
  121.             setWinInfo read-only 1
  122.             setWinInfo dirty 0
  123.             goto 0
  124.         } else {
  125.             alertnote "'$res's value is:¥r¥r$val¥r"
  126.         }
  127.     } else {
  128.         global $res
  129.         alertnote "'$res's value is:¥r¥r$prefDefs($res)"
  130.     }
  131.  
  132.     unset prefDefs arrprefDefs
  133. }
  134.  
  135. proc removeSavedSetting {} {
  136.     global prefDefs arrprefDefs
  137.     
  138.     saveModifiedVars
  139.     
  140.     readDefs
  141.     readDefs arr
  142.     set res [listpick -p "Remove which setting?" [lsort -ignore [getSavedSettings]]]
  143.  
  144.     if {$res == ""} return
  145.     if {[regexp {([^(]+)¥(([^)]+)¥)} $res dummy arr field]} {
  146.         global $arr
  147. #         catch {unset ${arr}($field)}
  148.         removeArrDef $arr $field
  149.     } else {
  150.         global $res
  151. #         catch {unset $res}
  152.         removeDef $res
  153.     }
  154.  
  155.     unset prefDefs arrprefDefs
  156. }
  157.  
  158.  
  159. proc getSavedSettings {} {
  160.     global prefDefs arrprefDefs
  161.     
  162.     readDefs
  163.     readDefs arr
  164.     
  165.     set names [array names prefDefs]
  166.     foreach pair [array names arrprefDefs] {
  167.         lappend names "[lindex $pair 0]([lindex $pair 1])"
  168.     }
  169.     
  170.     return [lsort $names]
  171. }
  172.  
  173. #===============================================================================
  174.  
  175. proc buildRecentFiles {} {
  176.     global recentFilesSave recentFiles modifiedVars
  177.     
  178.     lappend modifiedVars
  179.     
  180.     message "Building recent files menuﾉ"
  181.     if {[info exists recentFiles]} {
  182.         set recentFilesSave $recentFiles
  183.     }
  184.     if {[info exists recentFilesSave]} {
  185.         foreach f $recentFilesSave {
  186.             pushRecent $f
  187.         }
  188.     }
  189.         
  190.     catch {unset recentFilesSave}
  191. }
  192.  
  193.  
  194. proc appendText {t item} {return "$item$t"}
  195.  
  196. proc pushRecent {name} {
  197.     global recentFiles
  198.     
  199.     regsub { <¥w+>} $name {} name
  200.     if {[string match {*¥**} $name] || [string match "Untit*" $name] } return
  201.     if {[info exists recentFiles] && ([set ind [lsearch -glob $recentFiles "*[file tail $name]"]] >= 0)} {
  202.         set recentFiles [lreplace $recentFiles $ind $ind]
  203.     }
  204.     lappend recentFiles $name
  205.     if {[llength $recentFiles] > 10} {
  206.         set recentFiles [lrange $recentFiles 1 end]
  207.     }
  208.     set tails [map {file tail} $recentFiles]
  209.  
  210.     menu -m -c -n recent -p recentProc [concat [lsort -ignore $tails] [list "(-" "Reset List"]]
  211. }
  212.  
  213. proc recentProc {menu name} {
  214.     global recentFiles
  215.     
  216.     if {$name == "Reset List"} {
  217.         set recentFiles {}
  218.         menu -m -n recent -p recentProc {}
  219.     } else {
  220.         if {[set ind [lsearch $recentFiles "*:$name"]] >= 0} {
  221.             edit [lindex $recentFiles $ind]
  222.         }
  223.     }
  224. }
  225.  
  226.  
  227. proc editRecentFile {} {
  228.     global recentFiles
  229.     
  230.     foreach f $recentFiles {
  231.         lappend tails [file tail $f]
  232.     }
  233.     
  234.     foreach res [listpick -l -p {File?} [lsort -ignore $tails]]  {
  235.         set ind [lsearch $recentFiles ¥*:$res]
  236.         catch {edit [lindex $recentFiles $ind]}
  237.     }
  238. }
  239.  
  240.  
  241. #===============================================================================
  242.  
  243. proc editPrefs {} {
  244.     global PREFS
  245.     if {![file exists "$PREFS:prefs.tcl"]} {
  246.         set fd [open "$PREFS:prefs.tcl" "w"]
  247.         close $fd
  248.     }
  249.     edit "$PREFS:prefs.tcl"
  250. }
  251.  
  252. # Automatically add a line to the user input file
  253. proc addUserLine {line} {
  254.     global HOME PREFS
  255.  
  256.     if {![file exists "$PREFS"]} {
  257.         mkdir "$PREFS"
  258.     }
  259.     set fid [open "$PREFS:prefs.tcl" "a+"]
  260.     if {![catch {seek $fid -1 end}]} {
  261.         if {[read $fid 1] == "¥r"} {
  262.             set line "¥r$line"
  263.         }
  264.     }
  265.     seek $fid 0 end
  266.     puts $fid $line
  267.     close $fid
  268. }
  269.  
  270.  
  271.  
  272. #===============================================================================
  273.  
  274. proc sourceCurrentModePrefs {} { 
  275.     global mode PREFS
  276.     if {[file exists "${PREFS}:${mode}Prefs.tcl"]} {
  277.         source  "${PREFS}:${mode}Prefs.tcl"
  278.     } else {
  279.         beep; message "Sorry, no preferences for '$mode' mode"
  280.     }
  281. }
  282.  
  283.  
  284. proc editCurrentModePrefs {} { 
  285.     global mode
  286.     editPrefsProc modePrefs $mode
  287. }
  288.  
  289.  
  290. proc editPrefsProc { menu m } {
  291.     message $m
  292.     global PREFS mode
  293.     # assume it is a mode, since we made the menu
  294.     
  295.     set f "$PREFS:${m}Prefs.tcl"
  296.     if [file exists $f] {
  297.         edit $f
  298.     } else {
  299.         if { [askyesno "No '$m' prefs file exists, do you want to create one?"] ¥
  300.             == "yes" } {
  301.             
  302.             set fd [open $f "w"]
  303.             close $fd
  304.             edit $f
  305.             insertText {## 
  306.  # This    file will be sourced automatically, immediately after 
  307.  # the _first_ time    the    file which defines its mode is sourced.
  308.  # Use this    file to    insert your    own    mode-specific preferences
  309.  # and changes,    rather than    altering the originals.
  310.  # 
  311.  # You can redefine    menus, procedures, variables,...
  312.  ##
  313.  
  314. }}}
  315.             
  316. }
  317.  
  318.